home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / CO39 / CO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-10  |  42KB  |  1,379 lines
  1. {CO - A Win 3.1 Menu }
  2. {Rel 3.9} {tabs = 2}
  3. program CO;
  4. {$S-}{$R co.RES}{$R-}{$X+}{$V-}
  5. {$D CO Copyright (C) Doug Overmyer 12/17/91}
  6. uses WinTypes,WinProcs,Strings,WObjects,WinDos,filecopy,WFPlus,Buttons,
  7.     SclpText,WIN31,ShellAPI,Bitmap,CommDlg;
  8. const
  9.     id_BMP       = 99;
  10.   id_RGB       = 100;
  11.     id_ButOffset = 120;
  12.      id_But0    = 200;     {Base value of Icon buttons   }
  13.   id_But1    = 201;     {User defined button 1 iconbar}
  14.   id_But2    = 202;     {      "             2 iconbar}
  15.   id_But3    = 203;     {      "             3 iconbar}
  16.   id_But4    = 204;     {      "             3 iconbar}
  17.   id_But5    = 205;     {      "             5 iconbar}
  18.   id_But6    = 206;     {User defined button 6 iconbar}
  19.   id_But7    = 207;     {      "             7 iconbar}
  20.   id_But8    = 208;     {      "             8 iconbar}
  21.   id_But9    = 209;     {      "             9 iconbar}
  22.   id_But10   = 210;     {      "            10 iconbar}
  23.   id_But11   = 211;     {      "            11        }
  24.   id_But12   = 212;     {                   12        }
  25.   id_But13   = 213;     {                   13        }
  26.   id_But14   = 214;     {                   14        }
  27.   id_But15   = 215;     {                   15        }
  28.   id_But21   = 221;     {page 1 icon}
  29.   id_But22   = 222;     {page 2 icon}
  30.   id_But23   = 223;     {page 3 icon}
  31.   id_But24   = 224;     {page 4 icon}
  32.   id_Gb1     = 300;     {group box for radio buttons}
  33.   id_GB2     = 200;     {group box for page icons}
  34.   id_St1     = 401;     {Static text 1         icon bar}
  35.   id_St2     = 402;     {Static text 2         icon bar}
  36.   id_Pict    = 501;
  37.   id_D1      = 550;     {Dlg1 - Autoiconize & Setfonts}
  38.   id_D1RB1   = 551;     { autoiconize}
  39.   id_D1RB2   = 552;     { don't }
  40.   id_D1SetFont = 553;   { SetFont button}
  41.   id_D2OK    = 601;     {Dlg2 - Properties  }
  42.   id_D2Browse= 650;     { browse button}
  43.   id_D2EC1   = 603;     { item #}
  44.   id_D2EC2   = 605;     { Name}
  45.   id_D2EC3   = 607;     { file}
  46.   id_D2EC4   = 609;     { Start directory}
  47.   id_D2EC5   = 617;     { parameters}
  48.   id_D2EC6   = 621;     { start size}
  49.   id_D2EC7   = 623;     { Autosize }
  50.   id_D3LB1   = 701;     {Dlg3 - Drive Space}
  51.   idm_About  = 801;     {menu id for CO_Abut menu}
  52.   id_Timer   = 901;     {timer id}
  53.   INISECT = 'OM';
  54. {************************  Types    ************************}
  55. type
  56. TCOApplication = object(TApplication)
  57.       SplashRect: TRect;
  58.   procedure InitApplication;virtual;
  59.   procedure InitMainWindow;virtual;
  60.   procedure Redraw;
  61. end;
  62.  
  63. ItemRec = record
  64. ItemNum,PgmName,PgmFile,Dir,Params,Cmdshow,AStart:Array[0..69] of Char;
  65. end;
  66.  
  67. PPgmItem = ^TPgmItem;
  68. TPgmItem = object(TObject)
  69.         PgmName:PChar;
  70.       PgmFile:PChar;
  71.       Dir:PChar;
  72.       Params:PChar;
  73.       CmdShow:PChar;
  74.     AStart:PChar;
  75.   constructor Init(NewPgmName,NewPgmFile,NewDir,NewParams,
  76.             NewCmdShow,NewAStart:PChar);
  77.   destructor Done;virtual;
  78. end;
  79.  
  80. PCOCol = ^TCOCol;
  81. TCOCol = object(TCollection)
  82.         IniFile:Array[0..79] of Char;
  83.         TheItems:PCollection;
  84.     constructor Init(ALimit,ADelta:Integer;NewIniFile:PChar);
  85.   destructor Done;virtual;
  86.   function At(Indx:Integer):PPgmItem;virtual;
  87.   procedure ReadItems(Start,Finish:Integer);virtual;
  88.     procedure ItemGet(var PgmItem:ItemRec);virtual;
  89.     procedure ItemSet(PgmItem:ItemRec);virtual;
  90.   function GetCount:Integer;virtual;
  91.   function IsValidIndx(Indx:Integer):Boolean;
  92. end;
  93.  
  94. PCODlg1 = ^TCODlg1;
  95. TCODlg1 = object(TDialog)
  96.     procedure IDSetFont(var Msg:TMessage);virtual id_first+id_D1SetFont;
  97. end;
  98.  
  99. PCODlg2 = ^TCODlg2;
  100. TCODlg2 = object(TDialog)              {Item setup dialog}
  101.         EC1,EC2,EC3,EC4,EC5,EC6,EC7:PEdit;
  102.   constructor Init(AParent:PWindowsObject;AName:PChar);
  103.   procedure IDD2OK(var Msg:TMessage); virtual id_First+id_D2OK;
  104.   procedure IDBrowse(var Msg:TMessage);virtual id_First+id_D2Browse;
  105. end;
  106.  
  107. PCODlg3 = ^TCODlg3;
  108. TCODlg3 = object(TDialog)              {Run dialog}
  109.     procedure SetupWindow; virtual;
  110. end;
  111.  
  112. PCOAboutDlg = ^TCOAboutDlg;
  113. TCOAboutDlg = object(TDialog)
  114.         Logo:HBitmap;
  115.   constructor Init(AParent:PWindowsObject;AName:PChar;ALogo:HBitmap);
  116.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  117. end;
  118.  
  119. PCORButton = ^TCORButton;
  120. TCORButton = object(TRadioButton)
  121.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  122. end;
  123.  
  124. PCOGroupBox = ^TCOGroupBox;
  125. TCOGroupBox = object(TGroupBox)
  126.     procedure SetupWindow;virtual;
  127.   function CanClose:Boolean;virtual;
  128.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  129. end;
  130.  
  131. PCOStatic = ^TCOStatic;
  132. TCOStatic = object(TSText)
  133.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  134. end;
  135.  
  136. type
  137. PCOWindow = ^TCOWindow;
  138. TCOWindow = object(TWindow)
  139.       BN1:Array[0..10] of PODDButton;  {icon bar button pointers}
  140.       BN2:Array[0..5] of PODButton;
  141.       BNR:Array[0..5] of PODDButton; {page icons}
  142.       GB1:PCOGroupBox;
  143.       GB2:PODDGroupBox;
  144.       RB:Array[0..20] of PCORButton; {radio button pointers id's 301-320}
  145.       ST1:PCOStatic;
  146.     St2:PCOStatic;
  147.       Apps:PCOCol;
  148.       Logo,Pict:HBitmap;
  149.       PictRect,MPR:TRect;
  150.       PageNum,AutoMin:Integer;
  151.       TheFont:HFont;
  152.       D2TfB:ItemRec;
  153.       Bitmap:PTBMP;
  154.       StatDisp:Char;
  155.       IniFile:Array[0..79] of Char;
  156.       BkBrush:HBrush;
  157.       LogFont:TLogFont;
  158.       FontSize:Integer;
  159.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  160.   destructor Done;virtual;
  161.   procedure SetupWindow;virtual;
  162.   function GetClassName:PChar;virtual;
  163.   procedure SetRBText;virtual;
  164.   procedure AutoStart;
  165.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  166.   procedure SetStaticText;
  167.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  168.     procedure IDBut11(var Msg:TMessage);virtual id_First+id_But11; { }
  169.   procedure IDBut12(var Msg:TMessage);virtual id_First+id_But12; { }
  170.   procedure    IDBut13(var Msg:TMessage);virtual id_First+id_But13; { }
  171.   procedure IDBut14(var Msg:TMessage);virtual id_First+id_But14; { }
  172.   procedure IDBut15(var Msg:TMessage);virtual id_First+id_But15; {Free Icon}
  173.   procedure DefChildProc(var Msg:TMessage);virtual;
  174.   procedure WinExecc(var Msg:TMessage);virtual;
  175.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  176.   procedure SetItemValues(PgmItem:ItemRec);virtual;
  177.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  178.   procedure RunIt;virtual;
  179.   procedure UMDropFiles(var Msg:TMessage);virtual wm_User+wm_Dropfiles;
  180.     procedure UMRButtonDown(var Msg:TMessage);virtual wm_User+wm_RButtonDown;
  181.     procedure LoadBMP(BMPName:PChar);
  182.   function CtrlToIndx(Id:Integer):Integer;virtual;
  183.   procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  184.   procedure SetStatProp(var Msg:TMessage);virtual;
  185.   procedure SetButProp(var Msg:TMessage);virtual;
  186.   procedure SetBMPProp(var Msg:TMessage);virtual;
  187.   procedure SetRGBProp(var Msg:TMessage);virtual;
  188.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  189.   procedure GetPictRect;virtual;
  190.   procedure CreateBrush(BkgndColor:PChar);virtual;
  191.   procedure WMNCRButtonDown(var Msg:TMessage);virtual wm_First+wm_NCRButtonDown;
  192.   procedure WMEraseBkGnd(var Msg:TMessage);virtual wm_First+wm_EraseBkGnd;
  193.   procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
  194.   procedure UMSetFont(var Msg:TMessage);virtual WM_USER+ID_D1SETFONT;
  195. end;
  196. {***********************  functions  *******************************}
  197.  
  198. {***********************  Methods    *******************************}
  199. procedure TCOApplication.InitApplication;
  200. var
  201.   DC, MemDC: HDC;
  202.   OldBitMap, BitMap: HBitMap;
  203.   BM: TBitMap;
  204. begin
  205.   DC := CreateDC('Display', Nil, Nil, Nil);
  206.   BitMap := LoadBitMap(HInstance, 'CO_Logo');
  207.   MemDC := CreateCompatibleDC(DC);
  208.   OldBitMap := SelectObject(MemDC, BitMap);
  209.   GetObject(BitMap, SizeOf(BM), @BM);
  210.   with SplashRect do
  211.   begin
  212.     Left := 200;
  213.     Top := 150;
  214.     Right := Left + BM.bmWidth;
  215.     Bottom := Top + BM.bmHeight;
  216.     BitBlt(DC, Left, Top, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCopy);
  217.   end;
  218.   DeleteObject(SelectObject(MemDC, OldBitMap));
  219.   DeleteDC(MemDC);
  220.   DeleteDC(DC);
  221.   TApplication.InitApplication;
  222. end;
  223.  
  224. procedure TCOApplication.InitMainWindow;
  225. begin
  226.     MainWindow := New(PCOWindow,Init(nil,'chez O'''));
  227. end;
  228.  
  229. procedure TCOApplication.Redraw;
  230. begin
  231.     if SplashRect.left = 200 then
  232.         InvalidateRect(0,@SplashRect,True);
  233. end;
  234. {**********************  TCOWindow  *******************************}
  235. constructor TCOWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  236. Const
  237.     BMP:Array[0..25] of PChar = ('','','','','','','','','','','',
  238.   'CO_B1','CO_B2','CO_B3', 'CO_B4', 'CO_B5',
  239.   '','','','','',
  240.   'CO_B21', 'cO_B22','CO_B23','CO_B24','');
  241. {bitmaps CO_B1 to CO_B5 are 34 x 34 16 color resources}
  242. var
  243.   TheBmp:HBitmap;
  244.   Buf:Array[0..69] of Char;
  245.   Indx,ErrCode:Integer;
  246.   TheItem:PPgmItem;
  247.   Buf1:Array[0..80] of Char;
  248. begin
  249.     TWindow.Init(AParent,ATitle);
  250.   Attr.Menu := 0; 
  251.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
  252.   Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  253.  
  254.   StrCopy(IniFile,'CO.INI');
  255.     if StrLen(CmdLine) <> 0 then StrCopy(IniFile,CmdLine);
  256.     Logo := 0;Pict := 0;PageNum := 1;BkBrush := 0;
  257.  
  258.   Apps := New(PCOCol,Init(111,20,IniFile));
  259.   Apps^.ReadItems(0,110);
  260.   For Indx := 0 to 10 do BN1[Indx] := nil;
  261.   For Indx := 0 to 5 do BN2[Indx] := nil;
  262.   For Indx := 0 to 4 do BNR[Indx] := nil;
  263.   For Indx := 0 to 20 do RB[Indx] := nil;
  264.   For Indx := 1 to 10 do
  265.       begin
  266.     TheItem := Apps^.At(Indx+80);
  267.       BN1[Indx]:=New(PODDButton,Init(@Self,id_GB2+Indx,'',Pred(Indx)*35,0,35,35,False,TheItem^.PgmFile,nil));
  268.       end;
  269.     For Indx := 1 to 5 do
  270.       BN2[Indx]:=New(PODButton,Init(@Self,id_GB2+10+Indx,'',Pred(Indx)*35,35,35,35,False,BMP[Indx+10],nil));
  271.   GB2 := New(PODDGroupBox,Init(@Self,id_Gb2,'',0,35,34,34));
  272.   For Indx := 1 to 4 do
  273.       begin
  274.     TheItem := Apps^.At(Indx+100);
  275.     if TheItem^.Pgmfile = nil then
  276.             BNR[Indx] := New(PODDButton,Init(@Self,Indx+220,'',0,35,35,35,False,BMP[Indx+20],GB2))
  277.     else
  278.             BNR[Indx] := New(PODDButton,Init(@Self,Indx+220,'',0,35,35,35,False,TheItem^.PgmFile,GB2));
  279.     end;
  280.   St1 := New(PCOStatic,Init(@Self,id_St1,'',355,5,235,25,sr_Recessed,
  281.               dt_Center or dt_VCenter or dt_SingleLine));
  282.   GB1 := New(PCOGroupBox,Init(@Self,id_Gb1,'',200,50,350,230));
  283.   St2 := New(PCOStatic,Init(@Self,id_St2,'',220,54,150,20,SR_Recessed,
  284.               dt_Center or dt_VCenter or dt_SingleLine));
  285.   For Indx := 1 to 10 do
  286.       RB[Indx]:=New(PCORButton,Init(@Self,(id_GB1+Indx),'',215,(75+Pred(Indx)*20),160,20,GB1));
  287.   For Indx := 11 to 20 do
  288.       RB[Indx]:=New(PCORButton,Init(@Self,(id_GB1+Indx),'',385,(75+(Indx-11)*20),160,20,GB1));
  289.  
  290.     AutoMin :=Min(2,GetPrivateProfileInt(INISECT,'AutoMin',0,IniFile));
  291.   BNR[1]^.State := 1;
  292.   GB2^.SelectionChanged(id_But21);
  293.     GetPrivateProfileString(INISECT,'StatDisp','M',Buf,SizeOf(Buf),IniFile);
  294.   StatDisp := Buf[0];
  295.  
  296.     FontSize:= GetPrivateProfileInt(INISECT,'FontSize',80,IniFile);
  297.   with LogFont do
  298.       begin
  299.     GetPrivateProfileString(INISECT,'lfHeight','',Buf1,sizeof(Buf1),IniFile);
  300.     Val(Buf1,lfHeight,errcode);
  301.     lfWidth := GetPrivateProfileInt(INISECT,'lfWidth',0,IniFile);
  302.     lfEscapement := GetPrivateProfileInt(INISECT,'lfEscapement',0,IniFile);
  303.     lfOrientation := GetPrivateProfileInt(INISECT,'lfOrientation',0,IniFile);
  304.  
  305.     lfWeight := GetPrivateProfileInt(INISECT,'lfWeight',0,IniFile);
  306.     lfItalic := GetPrivateProfileInt(INISECT,'lfItalic',0,IniFile);
  307.     lfUnderLine := GetPrivateProfileInt(INISECT,'lfUnderline',0,IniFile);
  308.     lfStrikeout := GetPrivateProfileInt(INISECT,'lfStrikeout',0,IniFile);
  309.  
  310.     lfCharSet := GetPrivateProfileInt(INISECT,'lfCharSet',0,IniFile);
  311.     lfOutPrecision := GetPrivateProfileInt(INISECT,'lfOutPrecision',0,IniFile);
  312.     lfClipPrecision := GetPrivateProfileInt(INISECT,'lfClipPrecision',0,IniFile);
  313.     lfQuality := GetPrivateProfileInt(INISECT,'lfQuality',0,IniFile);
  314.     lfPitchAndFamily := GetPrivateProfileInt(INISECT,'lfPitchAndFamily',0,IniFile);
  315.     GetPrivateProfileString(INISECT,'lfFaceName','System',lfFaceName,sizeof(lfFaceName),IniFile);
  316.   end;
  317. end;
  318.  
  319. function TCOWindow.GetClassName:Pchar;
  320. begin
  321.     GetClassName := 'COWindow';
  322. end;
  323.  
  324. procedure TCOWindow.SetupWindow;
  325. var
  326.     SysMenu:hMenu;
  327.   Indx:Word;
  328.   CR:TRect;
  329.   NewTop,cModule:Integer;
  330.   Msg:TMessage;
  331.   Buf:Array [0..79] of Char;
  332. begin
  333.     TWindow.SetupWindow;
  334.   if GetModuleUsage(HInstance)=1 then
  335.         SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'CO_Icon'));
  336.     GetPrivateProfileString(INISECT,'BkgndColor','12632256',Buf,SizeOf(Buf),IniFile);
  337.   CreateBrush(Buf);
  338.   Sysmenu := GetSystemMenu(hWindow,false);
  339.   AppendMenu(SysMenu,MF_Separator,0,nil);
  340.   AppendMenu(Sysmenu,0,idm_About,'About...');
  341.   TheFont := CreateFontIndirect(LogFont);
  342.   GetClientRect(HWindow,CR);
  343.   NewTop := CR.Bottom-Cr.Top-35;
  344.   for Indx := 1  to 4 do
  345.       if BNR[Indx] <> nil then
  346.         begin
  347.         MoveWindow(BNR[Indx]^.HWindow,35*Pred(Indx),NewTop,35,35,False);
  348.       MoveWindow(GB2^.HWindow,0,NewTOP,35*(Indx),35,False);
  349.       end;
  350.     For Indx := 1 to 20 do
  351.         SendMessage(RB[Indx]^.HWindow,WM_SETFONT,TheFont,0);
  352.   SendMessage(GB1^.HWindow,WM_SETFONT,TheFont,0);
  353.   St1^.SetFont(TheFont);
  354.   St2^.SetFont(TheFont);
  355.     GetPrivateProfileString(INISECT,'PgmFile99','COLOGO.BMP',Buf,SizeOf(Buf),IniFile);
  356.   Bitmap:= New(PTBMP,Init('xx'));
  357.   if StrLen(Buf) <> 0 then
  358.       Bitmap^.LoadBitmapFile(buf);
  359.   Pict := Bitmap^.DDB;
  360.   Logo := LoadBitmap(HInstance,'CO_Logo');
  361.   if Pict = 0 then
  362.       Pict := Logo;
  363.   SetRect(MPR,5,75,185,CR.Bottom-40);
  364.   GetPictRect;
  365.     SetStaticText;
  366.   SetRBText;
  367.   DragAcceptFiles(HWindow,TRUE);
  368.   SetTimer(HWindow,id_Timer,30000,nil);
  369.   AutoStart;
  370. end;
  371.  
  372. procedure TCOWindow.SetStaticText;
  373. var
  374.   Buf,Buf1:Array[0..55] of Char;
  375.   Mem :Record
  376.       GlobalFreeMem,User,GDI:LongInt;
  377.   end;
  378.   Res:Record
  379.       HRes,VRes,NColors:Integer;
  380.   end;
  381.   PageNumBuf:Array[0..25] of Char;
  382.   nBitsPixel,nPlanes,nSizePalette:Integer;
  383.   DC:HDc;
  384.   R:TRect;
  385.   Item:PPgmItem;
  386. begin
  387. if StatDisp = 'M' then
  388.     begin
  389.     Mem.GlobalFreeMem := Round(GetFreeSpace(0) / 1024);
  390.   Mem.GDI := GetFreeSystemResources(1);
  391.   Mem.User := GetFreeSystemResources(2);
  392.   wvsprintf(Buf,'GMem:%luK  User:%lu%%  GDI:%li%%',Mem);
  393.   end
  394. else
  395.     begin
  396.   Res.HRes := GetSystemMetrics(sm_CXScreen);
  397.   Res.VRes := GetSystemMetrics(sm_CYScreen);
  398.   DC := GetDC(HWindow);
  399.   nPlanes := GetDeviceCaps(DC,Planes);
  400.   nBitsPixel := GetDeviceCaps(DC,BitsPixel);
  401.   nSizePalette := GetDeviceCaps(DC,SizePalette);
  402.   if (RC_Palette AND GetDeviceCaps(DC,RASTERCAPS)) > 0 then
  403.       Res.NColors := nSizePalette
  404.   else
  405.          Res.NColors := (nPlanes * nBitsPixel) shl 2 ;
  406.   ReleaseDC(HWindow,DC);
  407.   wvsprintf(Buf,'HRes:%i  VRes:%i  #Colors:%i',Res);
  408.     end;
  409.   St1^.SetText(Buf);
  410.   GetWindowText(GB1^.HWindow,Buf1,sizeof(Buf1));
  411.   Str(PageNum,PageNumBuf);
  412.   StrCat(StrCopy(Buf,'Page: '),PageNumBuf);
  413.   Item :=Apps^.At(PageNum+100);
  414.     if Item^.PgmName <> nil then
  415.       StrCopy(Buf,Item^.PgmName);
  416.   if StrIComp(Buf,Buf1) <> 0 then
  417.        St2^.SetText(Buf);
  418. end;
  419.  
  420. procedure TCOWindow.SetRBText;
  421. var
  422.     Offset:Integer;
  423.     ChildWin:PRadioButton;
  424.   Indx:Integer;
  425.   Item:PPgmItem;
  426. begin
  427.     Offset := Pred(PageNum)*20;
  428.     For Indx := Offset+1 to Offset+20 do
  429.       begin
  430.     Item := Apps^.At(Indx);
  431.     SetWindowText(RB[Indx-OffSet]^.HWindow,Item^.PgmName);
  432.       end;
  433. end;
  434.  
  435. procedure TCOWindow.AutoStart;
  436. var
  437.     Indx:Integer;
  438.   Item:PPgmItem;
  439.   Buf:Array[0..100] of Char;
  440.   Errval:Integer;
  441.   nCmdShow,CmdShow:Integer;
  442.   Iconize:Boolean;
  443. begin
  444.     Iconize := False;
  445.      for Indx := 1 to 80 do
  446.       begin
  447.         Item := Apps^.At(Indx);
  448.     if (Item^.PgmName <> nil) and
  449.          (Item^.AStart <> nil) and
  450.        (Item^.AStart[0] = 'Y') then
  451.         begin
  452.           StrCopy(Buf,Item^.PgmFile);
  453.           if (Item^.Params <> NIL) then
  454.               StrCat(StrCat(Buf,' '),Item^.Params);
  455.           if (Item^.Cmdshow <> NIL) then
  456.               case Item^.CmdShow[0] of
  457.                 'N','n':Cmdshow := sw_Normal;
  458.               'M','m':CmdShow := sw_Maximize;
  459.               'I','i':CmdShow := sw_Minimize;
  460.              else
  461.               CmdShow := sw_Normal;
  462.             end
  463.           else
  464.               CmdShow := sw_Normal;
  465.             if (Item^.Dir <> NIL) then
  466.               SetCurdir(Item^.Dir);
  467.           WinExec(Buf,CmdShow);
  468.       Iconize := True;
  469.       end;
  470.     end;
  471.   if (AutoMin = 1) and Iconize then
  472.       PostMessage(HWindow,wm_SysCommand,sc_Icon,0);
  473. end;
  474.  
  475. destructor TCOWindow.Done;
  476. begin
  477.     KillTimer(HWindow,id_Timer);
  478.     Dispose(Bitmap,Done);
  479.     DeleteObject(TheFont);
  480.   Dispose(Apps,Done);
  481.   if Logo <> 0 then DeleteObject(Logo);
  482.     if BkBrush <> 0 then DeleteObject(BkBrush);
  483.   DragAcceptFiles(HWindow,FALSE);
  484.   TWindow.Done;
  485. end;
  486.  
  487. procedure TCOWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  488. const
  489.     X1=190; Y1=48; X2=560; Y2=290;
  490. var
  491.     ThePen,OldPen:HPen;
  492.   TheBrush,OldBrush:HBrush;
  493.   MemDC:hDC;
  494.   CR:TRect;
  495. begin
  496.     TheBrush := GetStockObject(LtGray_Brush);
  497.     ThePen := CreatePen(ps_Solid,1,$00000000);
  498.   OldPen := SelectObject(PaintDC,ThePen);
  499.   OldBrush := SelectObject(PaintDC,TheBrush);
  500.   GetClientRect(HWindow,CR);
  501.   Rectangle(PaintDC,0,0,CR.Right-CR.Left,35);
  502.   SelectObject(PaintDC,OldBrush);
  503.   SelectObject(PaintDC,OldPen);
  504.   DeleteObject(ThePen);
  505.   DeleteObject(TheBrush);
  506.   SRectangle(PaintDC,X1,Y1,X2,Y2,2,sr_Recessed);
  507.     Bitmap^.Draw(PaintDC,PictRect,False);
  508. end;
  509.  
  510. procedure    TCOWindow.WMDrawItem(var Msg:TMessage);
  511. var
  512.     PDIS : ^TDrawItemStruct;
  513. begin
  514.     PDIS := Pointer(Msg.lParam);
  515.     case PDIS^.CtlType of
  516.         odt_Button:
  517.         case PDIS^.CtlID of
  518.             id_But1..id_But10:Bn1[PDIS^.CtlID-200]^.DrawItem(Msg);
  519.             id_But11..id_But15:Bn2[PDIS^.CtlID-210]^.DrawItem(Msg);
  520.             id_But21..id_But24:BnR[PDIS^.CtlID-220]^.DrawItem(Msg);
  521.         end;
  522.     end;
  523. end;
  524.  
  525. procedure TCOWindow.IDBut11(var Msg:TMessage);
  526. var
  527.     Item:PPgmItem;
  528. begin
  529.     Item := Apps^.At(91);
  530.     if (Item^.Dir <> NIL) then
  531.           SetCurdir(Item^.Dir);
  532.   if (Item^.PgmFile <> nil) then
  533.       WinExec(Item^.PgmFile,sw_Normal)
  534.   else
  535.         WinExec('command.com',sw_Normal);
  536. end;
  537.  
  538. procedure TCOWindow.IDBut12(var Msg:TMessage);
  539. begin
  540.     Runit;
  541. end;
  542.  
  543. procedure TCOWindow.IDBut13(var Msg:TMessage);
  544. var
  545.     Dlg3:PCODlg3;
  546. begin
  547.     Dlg3 := New(PCODlg3,Init(@Self,'CO_Dlg3'));
  548.     Application^.ExecDialog(Dlg3);
  549. end;
  550.  
  551. procedure TCOWindow.IDBut14(var Msg:TMessage);
  552. var
  553.     FCWin:PFCWindow;
  554. begin
  555.     FCWin := New(PFCWindow,Init(@Self,'cO File'));
  556.   Application^.MakeWindow(FCWin);
  557.  
  558. end;
  559.  
  560. procedure TCOWindow.IDBut15(var Msg:TMessage);
  561. begin
  562.   ExitWindows(0,0);
  563. end;
  564.  
  565. procedure TCOWindow.DefChildProc(var Msg:TMessage);
  566. var
  567.     ID:Integer;
  568. begin
  569.   case Msg.WParam of
  570.       id_But1..id_But10:
  571.       WinExecc(Msg);
  572.     Succ(id_GB1)..id_GB1+20:
  573.       WinExecc(Msg);
  574.     id_But21..id_But24:
  575.             begin
  576.             PageNum := Msg.wParam-220;
  577.           SetRBText;
  578.           SetStaticText;
  579.             end;
  580.     else
  581.         TWindow.DefChildProc(Msg);
  582.     end;
  583. end;
  584.  
  585. procedure TCOWindow.WinExecc(var Msg:TMessage);
  586. var
  587.     Indx:Integer;
  588.     Item:PPgmItem;
  589.   Buf:Array[0..100] of Char;
  590.   Errval:Integer;
  591.   nCmdShow,CmdShow:Integer;
  592. begin
  593.     Indx := CtrlToIndx(Msg.wParam);
  594.     Item := Apps^.At(Indx);
  595.   if (Item^.PgmFile = NIL) then
  596.       begin
  597.       if (Msg.wParam > id_Gb1) then
  598.           RB[Msg.WParam-id_GB1]^.Toggle;
  599.     TWindow.DefChildProc(Msg);
  600.     Exit;
  601.     end;
  602.   StrCopy(Buf,Item^.PgmFile);
  603.   if (Item^.Params <> NIL) then
  604.           StrCat(StrCat(Buf,' '),Item^.Params);
  605.   if (Item^.Cmdshow <> NIL) then
  606.       case Item^.CmdShow[0] of
  607.         'N','n':Cmdshow := sw_Normal;
  608.       'M','m':CmdShow := sw_Maximize;
  609.       'I','i':CmdShow := sw_Minimize;
  610.         else
  611.           CmdShow := sw_Normal;
  612.     end
  613.   else
  614.       CmdShow := sw_Normal;
  615.     if (Item^.Dir <> NIL) then
  616.       SetCurdir(Item^.Dir);
  617.   WinExec(Buf,CmdShow);
  618.   if Msg.wParam > id_GB1 then
  619.         RB[Msg.WParam-id_GB1]^.Toggle;
  620.   If AutoMin = 1 then
  621.       ShowWindow(HWindow,sw_Minimize);
  622. end;
  623.  
  624. procedure    TCOWindow.WMSysCommand(var Msg:TMessage);
  625. begin
  626.     case Msg.Wparam of
  627.         idm_About:
  628.              Application^.ExecDialog(New(PCOAboutDlg,Init(@Self,'CO_About',Logo)));
  629.        else
  630.            DefWndProc(Msg);
  631.        end;
  632. end;
  633.  
  634. procedure TCOWindow.SetItemValues(PgmItem:ItemRec);
  635. begin
  636.     Apps^.ItemSet(PgmItem);
  637.   SetRBText;
  638. end;
  639.  
  640. procedure TCOWindow.WMCTLCOLOR(var Msg: TMessage);
  641. begin
  642.   case Msg.LParamHi of
  643.     ctlcolor_Btn:
  644.       begin
  645.       SetBkMode(Msg.WParam, Transparent);
  646.       Msg.Result := GetStockObject(ltGray_Brush);
  647.       end;
  648.   else
  649.     DefWndProc(Msg);
  650.   end;
  651. end;
  652.  
  653. procedure TCOWindow.Runit;
  654. const
  655.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  656. var
  657.   Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  658.     szDirName:Array[0..256] of Char;
  659.   szFile,szFileTitle:Array[0..256] of Char;
  660.   OFN:TOpenFileName;
  661. begin
  662.     StrCopy(szFile,'');
  663.   OFN.lStructSize := sizeof(TOpenFileName);
  664.   OFN.hWndOwner := HWindow;
  665.   OFN.lpStrFilter := @szFilter;
  666.   OFN.lpStrCustomFilter := nil;
  667.   OFN.nMaxCustFilter := 0;
  668.   OFN.nFilterIndex := LongInt(1);
  669.   OFN.lpStrFile := szFile;
  670.   OFN.nMaxFile := sizeof(szFile);
  671.   OFN.lpstrfileTitle := szFileTitle;
  672.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  673.   OFN.lpstrInitialDir := NIL;
  674.   OFN.lpStrTitle := 'Run A Program';
  675.   OFN.flags := 0;
  676.   OFN.nFileOffset := 0;
  677.   OFN.nFileExtension := 0;
  678.   OFN.lpstrDefext := nil;
  679.   If GetOpenFileName(OFN) then
  680.       begin
  681.     filesplit(szFile,Path,Name,Ext);
  682.     SetCurDir(Path);
  683.       WinExec(Name,sw_Normal);
  684.     SetCurdir(OldDir);
  685.       If AutoMin = 1 then
  686.           ShowWindow(HWindow,sw_Minimize);
  687.     end;
  688. end;
  689.  
  690. procedure TCOWindow.UMDropFiles(var Msg:TMessage);
  691. var
  692.     FileNamePtr:PChar;
  693.   CtrlID:Integer;
  694.     Buf1:Array[0..30] of Char;
  695.   Indx:Integer;
  696.     PgmItem:ItemRec;
  697.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  698. begin
  699.     FileNamePtr := Pointer(Msg.lParam);
  700.   FileSplit(FileNamePtr,Dir,Name,Ext);
  701.   AnsiLower(Name);
  702.   Name[0] := UpCase(Name[0]);
  703.     StrCopy(PgmItem.PgmName,Name);
  704.   StrCopy(PgmItem.PgmFile,FileNamePtr);
  705.   CtrlID :=Msg.wParam;
  706.   If CtrlID = id_Pict then
  707.       Indx := id_BMP
  708.   else
  709.         Indx := CtrlToIndx(Msg.wParam);
  710.   Str(Indx,PgmItem.ItemNum);
  711.   StrCopy(PgmItem.Dir,'');
  712.   StrCopy(PgmItem.Params,'');
  713.   StrCopy(PgmItem.CmdShow,'N');
  714.   StrCopy(PgmItem.AStart,'N');
  715.   SetItemValues(PgmItem);
  716. end;
  717.  
  718. procedure TCOWindow.UMRButtonDown(var Msg:TMessage);
  719. begin
  720.   if Msg.wParam = id_St1 then
  721.       SetStatProp(Msg)
  722.   else if (Msg.wParam > id_But11) and (Msg.wParam < Succ(id_But15)) then
  723.   else if (Msg.wParam = id_RGB) then
  724.       SetRGBProp(Msg)
  725.   else if (Msg.wParam = id_Pict) then
  726.       SetBMPProp(Msg)
  727.   else if (Msg.wParam > id_GB2) and (Msg.wParam < id_GB1+100) then
  728.       SetButProp(Msg)
  729.   else
  730.       DefWndProc(Msg);
  731. end;
  732.  
  733. function TCOWindow.CtrlToIndx(ID:Integer):Integer;
  734. begin
  735.     if ID > id_GB1 then
  736.         CtrlToIndx := ID - id_GB1 + (20*Pred(PageNum))
  737.   else
  738.         CtrlToIndx := ID - id_GB2 + 80;
  739. end;
  740.  
  741. procedure TCOWindow.WMRButtonDown(var Msg:TMessage);
  742. begin
  743.      if PtInRect(PictRect,MakePoint(Msg.lParam))  then
  744.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_Pict,Msg.lParam)
  745.   else
  746.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_RGB,Msg.lParam);
  747.     DefWndProc(Msg);
  748. end;
  749.  
  750. procedure TCOWindow.SetStatProp(var Msg:TMessage);
  751. const Statx:Array[0..1] of Char = ' ';
  752. begin
  753.     if StatDisp = 'M' then
  754.     StatDisp := 'R'
  755.   else
  756.         StatDisp := 'M';
  757.   Statx[0] := StatDisp;
  758.   WritePrivateProfileString(INISECT,'StatDisp',Statx,IniFile);
  759.   SetStaticText;
  760. end;
  761.  
  762. procedure TCOWindow.SetButProp(var Msg:TMessage);
  763. var
  764.   Dlg2:PCODlg2;
  765. begin
  766.   FillChar(D2TfB,sizeof(D2TfB),$0);
  767.     Dlg2 := New(PCODlg2,Init(@Self,'CO_Dlg2'));
  768.   Str(CtrlToIndx(Msg.wParam),D2TfB.ItemNum);
  769.   Dlg2^.TransferBuffer := @D2TfB;
  770.   Apps^.ItemGet(D2TfB);
  771.     if StrLen(D2TfB.Cmdshow) = 0 then
  772.       StrCopy(D2TfB.Cmdshow,'N');
  773.   if StrLen(D2TfB.AStart) = 0 then
  774.       StrCopy(D2TfB.AStart,'N');
  775.   if (Application^.ExecDialog(Dlg2) = 1) then
  776.       begin
  777.     SetItemValues(D2TfB);
  778.       if (Msg.wParam > id_But0) and (Msg.wParam < id_But11) then
  779.           BN1[Msg.wParam - id_But0]^.ChangeBMP(D2TfB.PgmFile)
  780.     else if (Msg.wParam >id_But15) and (Msg.wParam < id_But24+1) then
  781.         begin
  782.       if StrLen(D2TfB.PgmFile)> 0 then
  783.           BNR[Msg.wParam - 220]^.ChangeBMP(D2TfB.PgmFile);
  784.       SetStaticText;
  785.       end;
  786.       end;
  787. end;
  788.  
  789. procedure TCOWindow.SetBMPProp(var Msg:TMessage);
  790. var
  791.   Dlg2:PCODlg2;
  792. begin
  793.   FillChar(D2TfB,sizeof(D2TfB),$0);
  794.     Dlg2 := New(PCODlg2,Init(@Self,'CO_Dlg2'));
  795.   StrCopy(D2TfB.ItemNum,'99');
  796.   Dlg2^.TransferBuffer := @D2TfB;
  797.   Apps^.ItemGet(D2TfB);
  798.   StrCopy(D2TfB.Cmdshow,'N');
  799.   if (Application^.ExecDialog(Dlg2) = 1) then
  800.       begin
  801.     SetItemValues(D2TfB);
  802.       if  (StrLen(D2TfB.PgmFile) <> 0) then
  803.           LoadBMP(D2TfB.PgmFile);
  804.       end;
  805. end;
  806.  
  807. procedure TCOWindow.SetRGBProp(var Msg:TMessage);
  808. var
  809.     Chsclr:TChooseColor;
  810.   Color:LongInt;
  811.   ColorArray:Array[0..15] of LongInt;
  812.   Indx:Integer;
  813.   BkColor:Array[0..12] of Char;
  814.   Buf:Array[0..15] of Char;
  815.   Errornum:Integer;
  816. begin
  817.       begin
  818.       for Indx := 0 to 15 do ColorArray[Indx] := LongInt(RGB(255,255,255));
  819.         GetPrivateProfileString(INISECT,'BkgndColor','12632256',Buf,SizeOf(Buf),IniFile);
  820.     Val(Buf,Color,Errornum);
  821.       ChsClr.lStructsize:= sizeof(TChooseColor);
  822.       ChsClr.hWndOwner := HWindow;
  823.       ChsClr.hInstance := HInstance;
  824.       ChsClr.rgbResult := Color;
  825.        ChsClr.lpcustcolors := pLongInt(@ColorArray);
  826.       ChsClr.lcustdata := 0;
  827.       ChsClr.Flags :=  cc_RGBInit;
  828.       ChsClr.lptemplateName := PChar(nil);
  829.         if Choosecolor(ChsClr) then
  830.         begin
  831.         Str(ChsClr.rgbResult,BkColor);
  832.         WritePrivateProfileString(INISECT,'BkgndColor',BkColor,IniFile);
  833.       CreateBrush(BkColor);
  834.       end;
  835.     end;
  836. end;
  837.  
  838. procedure TCOWindow.WMDropFiles(var Msg:TMessage);
  839. var
  840.     DropItem:hDrop;
  841.   FileNameBuf:Array[0..fsPathName] of Char;
  842.   GFileName:PChar;
  843.   Loc:TPoint;
  844. begin
  845.     DropItem := Msg.wParam;
  846.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  847.   DragQueryPoint(DropItem,Loc);
  848.   DragFinish(DropItem);
  849.      if PtInRect(PictRect,Loc) then
  850.        begin
  851.       GFileName :=StrNew(FileNameBuf);
  852.       SendMessage(HWindow,wm_User+wm_DropFiles,id_Pict,LongInt(GFileName));
  853.     StrDispose(GFileName);
  854.     LoadBMP(FileNameBuf);
  855.       end;
  856. end;
  857.  
  858. procedure TCOWindow.LoadBMP(BMPName:PChar);
  859. begin
  860.     Dispose(BitMap,Done);
  861.   Bitmap:= New(PTBMP,Init('xx'));
  862.   Bitmap^.LoadBitmapFile(BMPName);
  863.   Pict := Bitmap^.DDB;
  864.   GetPictRect;
  865.   InvalidateRect(HWindow,nil,True);
  866.   UpdateWindow(HWindow);
  867. end;
  868.  
  869. procedure TCOWindow.GetPictRect;
  870. var
  871.     CR:TRect;
  872.   PictMetrics:TBitmap;
  873.   dW,dH:Integer;
  874. begin
  875.     GetClientRect(HWindow,CR);
  876.   GetObject(Pict,SizeOf(PictMetrics),@PictMetrics);
  877.   dW:=(MPR.Right-MPR.Left-PictMetrics.bmWidth) div 2;
  878.   dH := (MPR.Bottom-MPR.Top-PictMetrics.bmHeight) div 2;
  879.   PictRect.Left := Max(MPR.Left +dW , MPR.Left);
  880.   PictRect.Top := Max(MPR.Top+dH, MPR.Top);
  881.   PictRect.Right := Min(MPR.Right-dW,MPR.Right);
  882.   PictRect.Bottom := Min(MPR.Bottom-dH,MPR.Bottom);
  883. end;
  884.  
  885. procedure TCOWindow.CreateBrush(BkgndColor:PChar);
  886. var
  887.     DC,MemDC:HDC;
  888.   NewBmp,Bmp,OldBmp:HBitmap;
  889.   NewBrush,OldBrush,MonoBrush:HBrush;
  890.   nBkgndColor:TColorRef;
  891.   ErrCode:Integer;
  892.   BkgndBr:HBrush;
  893. begin
  894.   If BkBrush > 0 then
  895.       DeleteObject(BkBrush);
  896.   Val(BkgndColor,nBkgndColor,ErrCode);
  897.   Bmp :=LoadBitmap(HInstance,'CO_Br');
  898.   MonoBrush :=CreatePatternBrush(Bmp);
  899.     DC := GetDC(HWindow);
  900.   NewBMP := CreateCompatibleBitmap(DC,8,8);
  901.   MemDC := CreateCompatibleDC(DC);
  902.   SetTextColor(MemDC,nBkgndColor);
  903.   OldBrush := SelectObject(MemDC,MonoBrush);
  904.   OldBmp := SelectObject(MemDC,NewBmp);
  905.     PatBlt(MemDC,0,0,8,8,PatCopy);
  906.   SelectObject(MemDC,OldBmp);
  907.   SelectObject(MemDC,OldBrush);
  908.   DeleteObject(MonoBrush);
  909.   BkBrush := CreatePatternBrush(NewBMP);
  910.   DeleteObject(Bmp);
  911.   DeleteObject(NewBmp);
  912.   DeleteDC(MemDC);
  913.   ReleaseDC(HWindow,DC);
  914.   InvalidateRect(HWindow,nil,True);
  915. end;
  916.  
  917. procedure TCOWindow.WMNCRButtonDown(var Msg:TMessage);
  918. var
  919.     TheDialog:PCODlg1;
  920.     RadioRec :Record
  921.       RB1,RB2:Bool;
  922.   end;
  923.   RBut1,RBut2:PRadioButton;
  924.   FontBut:PButton;
  925. begin
  926.     TheDialog :=New(PCODlg1,Init(@Self,'CO_DLG1'));
  927.   New(RBut1,InitResource(TheDialog,id_D1RB1));
  928.   New(RBut2,InitResource(TheDialog,id_D1RB2));
  929.   New(FontBut,InitResource(TheDialog,id_D1SetFont));
  930.   RadioRec.RB1 := False;
  931.   RadioRec.RB2 := True;
  932.   TheDialog^.TransferBuffer := @RadioRec;
  933.   Application^.ExecDialog(TheDialog);
  934.   If RadioRec.RB1 then
  935.       begin
  936.     AutoMin := 1;
  937.     WritePrivateProfileString(INISECT,'AutoMin','1',IniFile);
  938.     end
  939.   else
  940.       begin
  941.     AutoMin := 0;
  942.     WritePrivateProfileString(INISECT,'AutoMin','0',IniFile);
  943.     end;
  944. end;
  945.  
  946. procedure TCOWindow.WMEraseBkGnd(var Msg:TMessage);
  947. var
  948.     Rect:TRect;
  949.   OldBrush:HBrush;
  950. begin
  951.     if BkBrush = 0 then
  952.   else
  953.       begin
  954.         UnrealizeObject(BkBrush);
  955.       OldBrush := SelectObject(Msg.WParam, BkBrush);
  956.       GetClientRect(HWindow, Rect);
  957.       PatBlt(Msg.wParam, Rect.left, Rect.top, Rect.right-Rect.left,
  958.               Rect.Bottom - Rect.Top, PATCOPY);
  959.       SelectObject(Msg.wParam, OldBrush);
  960.       end;
  961. end;
  962.  
  963. procedure TCOWindow.WMTimer(var Msg:TMessage);
  964. begin
  965.     if Msg.wParam = id_Timer then
  966.         SetStaticText;
  967. end;
  968.  
  969. procedure TCOWindow.UMSetFont(var Msg:TMessage);
  970. var
  971.     CF:TChooseFont;
  972.   DC:HDC;
  973.     Buf:Array[0..5] of Char;
  974.   Bufl:Array[0..65] of Char;
  975. begin
  976.   DC := GetDC(HWindow);
  977.   with CF do
  978.       begin
  979.     lStructSize := sizeof(TChooseFont);
  980.     hDC := DC;
  981.     hWndOwner := HWindow;
  982.     lpLogfont:= @LogFont;
  983.     iPointSize := FontSize    ;  {in tenths of a point}
  984.     Flags := CF_ScreenFonts or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT;
  985.     rgbColors:=RGB(255,0,0);
  986.     lCustData := 0;
  987.     @lpfnHook:= Pointer(0);
  988.     end;
  989.   if ChooseFont(CF) then
  990.       begin
  991.       ReleaseDC(HWindow,DC);
  992.       FontSize := CF.iPointSize;
  993.     DeleteObject(TheFont);
  994.       TheFont := CreateFontIndirect(LogFont);
  995.     SetStaticText;
  996.     with LogFont do
  997.           begin
  998.         Str(lfHeight,Buf);
  999.         WritePrivateProfileString(INISECT,'lfHeight',Buf,IniFile);
  1000.         Str(lfWidth,Buf);
  1001.         WritePrivateProfileString(INISECT,'lfWidth',Buf,IniFile);
  1002.         Str(lfEscapement,Buf);
  1003.         WritePrivateProfileString(INISECT,'lfEscapement',Buf,IniFile);
  1004.         Str(lfOrientation,Buf);
  1005.         WritePrivateProfileString(INISECT,'lfOrientation',Buf,IniFile);
  1006.         Str(lfWeight,Buf);
  1007.         WritePrivateProfileString(INISECT,'lfWeight',Buf,IniFile);
  1008.         Str(lfItalic,Buf);
  1009.         WritePrivateProfileString(INISECT,'lfItalic',Buf,IniFile);
  1010.         Str(lfUnderline,Buf);
  1011.         WritePrivateProfileString(INISECT,'lfUnderline',Buf,IniFile);
  1012.         Str(lfStrikeout,Buf);
  1013.         WritePrivateProfileString(INISECT,'lfStrikeout',Buf,IniFile);
  1014.         Str(lfCharSet,Buf);
  1015.         WritePrivateProfileString(INISECT,'lfCharSet',Buf,IniFile);
  1016.         Str(lfOutPrecision,Buf);
  1017.         WritePrivateProfileString(INISECT,'lfOutPrecision',Buf,IniFile);
  1018.         Str(lfClipPrecision,Buf);
  1019.         WritePrivateProfileString(INISECT,'lfClipPrecision',Buf,IniFile);
  1020.         Str(lfQuality,Buf);
  1021.         WritePrivateProfileString(INISECT,'lfQuality',Buf,IniFile);
  1022.         Str(lfPitchAndFamily,Buf);
  1023.         WritePrivateProfileString(INISECT,'lfPitchAndFamily',Buf,IniFile);
  1024.         WritePrivateProfileString(INISECT,'lfFaceName',lfFaceName,IniFile);
  1025.         Str(FontSize,Buf);
  1026.         WritePrivateProfileString(INISECT,'Fontsize',Buf,IniFile);
  1027.       end;
  1028.       SetRBText;
  1029.     end
  1030.   else
  1031.       ReleaseDC(HWindow,DC);
  1032. end;
  1033. {************************  TCODlg1  *****************************}
  1034. procedure TCODlg1.IDSetFont(var Msg:TMessage);
  1035. begin
  1036.     SendMessage(Parent^.HWindow,WM_USER+ID_D1SETFONT,0,0);
  1037. end;
  1038. {***********************  TCODlg2  ******************************}
  1039. constructor TCODlg2.Init(AParent:PWindowsObject;AName:PChar);
  1040. begin
  1041.     TDialog.Init(AParent,AName);
  1042.   New(EC1,InitResource(@Self,id_D2Ec1,70));
  1043.   New(EC2,InitResource(@Self,id_D2Ec2,70));
  1044.   New(EC3,InitResource(@Self,id_D2Ec3,70));
  1045.   New(EC4,InitResource(@Self,id_D2Ec4,70));
  1046.   New(EC5,InitResource(@Self,id_D2Ec5,70));
  1047.   New(EC6,InitResource(@Self,id_D2Ec6,70));
  1048.   New(EC7,InitResource(@Self,id_D2EC7,70));
  1049. end;
  1050.  
  1051. procedure TCODlg2.IDD2OK(var Msg:TMessage);
  1052. begin
  1053.     TransferData(tf_GetData);
  1054.   EndDlg(1);
  1055. end;
  1056.  
  1057. procedure TCODlg2.IDBrowse(var Msg:TMessage);
  1058. const
  1059.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  1060. var
  1061.   pBuf:PChar;
  1062.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  1063.     szDirName:Array[0..256] of Char;
  1064.   szFile,szFileTitle:Array[0..256] of Char;
  1065.   OFN:TOpenFileName;
  1066.   Ptr:PChar;
  1067. begin
  1068.     Ptr := @szFilter;
  1069.     StrCopy(szFile,'');
  1070.   OFN.lStructSize := sizeof(TOpenFileName);
  1071.   OFN.hWndOwner := HWindow;
  1072.   OFN.lpStrFilter := Ptr;
  1073.   OFN.lpStrCustomFilter := nil;
  1074.   OFN.nMaxCustFilter := 0;
  1075.   OFN.nFilterIndex := LongInt(1);
  1076.   OFN.lpStrFile := szFile;
  1077.   OFN.nMaxFile := sizeof(szFile);
  1078.   OFN.lpstrfileTitle := szFileTitle;
  1079.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  1080.   OFN.lpstrInitialDir := NIL;
  1081.   OFN.lpStrTitle := 'Select Program';
  1082.   OFN.flags := OFN_Pathmustexist or OFN_Filemustexist;
  1083.   OFN.nFileOffset := 0;
  1084.   OFN.nFileExtension := 0;
  1085.   OFN.lpstrDefext := nil;
  1086.   If GetOpenFileName(OFN) then
  1087.       begin
  1088.     FileSplit(szFile,Dir,Name,Ext);
  1089.     StrLower(Name);
  1090.     Name[0] := UpCase(Name[0]);
  1091.     pBuf := Name;
  1092.     EC2^.SetText(pBuf);
  1093.     pBuf := szFile;
  1094.       EC3^.SetText(pBuf);
  1095.     SetFocus(GetItemHandle(id_D2Ec4));
  1096.     end;
  1097. end;
  1098. {***********************  TCODlg3  ******************************}
  1099. procedure TCODlg3.SetupWindow;
  1100. var
  1101.     ArgList : record
  1102.         StrPtr : PChar;
  1103.       Free:PChar;
  1104.       Size:LongInt;
  1105.       PctFree:LongInt;
  1106.     end;
  1107.     szFree:Array[0..5] of Char;
  1108.   rFree:Real;
  1109.   szDr:Array[0..2] of Char;
  1110.   szOutput : Array[0..80] of Char;
  1111.   hListBox:hWnd;
  1112. begin
  1113.     TDialog.SetupWindow;
  1114.     hListBox :=GetItemHandle(Id_D3Lb1);
  1115.     SendMessage(hListBox,wm_SetFont,GetStockObject(OEM_Fixed_Font),0);
  1116.     DosError := 0; StrCopy(szOutput,'');
  1117.   WVSPrintf(szOutput,'Dr  MBf  MBt %%Free',ArgList);
  1118.   SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  1119.  
  1120.   StrCopy(szDr,'C:');
  1121.   while DosError = 0 do
  1122.        begin
  1123.     SetCurDir(szDr);
  1124.       if DosError = 0 then
  1125.           begin
  1126.         rFree := (DiskFree(0) / 1024 / 1024);
  1127.         Str(rFree:4:1,szFree);
  1128.         ArgList.Free := @szFree;
  1129.         ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
  1130.         ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
  1131.         ArgList.StrPtr := @szDr;
  1132.         WVSPrintf(szOutput,'%s %s  %3li  %3li',ArgList);
  1133.         SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  1134.         end;
  1135.         Inc(szDr[0]);
  1136.     end;
  1137. end;
  1138. {********************  TCOAbout     **************************}
  1139. constructor TCOAboutDlg.Init(AParent:PWindowsObject;AName:PChar;ALogo:HBitmap);
  1140. begin
  1141.     TDialog.Init(AParent,AName);
  1142.   Logo := ALogo;
  1143. end;
  1144.  
  1145. procedure TCOAboutDlg.WMCTLCOLOR(var Msg: TMessage);
  1146. const
  1147.   as_AboutSt1 =   126;  {about dlg static text   }
  1148.   as_AboutSt2 =   128;  {about dlg static blank static to draw upon}
  1149. var
  1150.     HSt1,HSt2:HWnd;
  1151.   MemDC:hDC;
  1152.   OldBitmap:HBitmap;
  1153.   CR:TRect;
  1154.   X,Y,W,H:Integer;
  1155.   LogoMetrics:TBitmap;
  1156. begin
  1157.   case Msg.LParamHi of
  1158.     ctlColor_Static:
  1159.       begin
  1160.         If (as_AboutSt1 = GetDlgCtrlID(Msg.lParamLo)) then
  1161.             SetTextColor(Msg.WParam, RGB(0,0,255))
  1162.         else  if (as_AboutSt2 = GetDlgCtrlID(Msg.lParamLo)) then
  1163.             begin
  1164.           MemDC := CreateCompatibleDC(Msg.WParam);
  1165.           OldBitmap := SelectObject(MemDC,Logo);
  1166.           GetClientRect(Msg.lParamLo,CR);
  1167.           W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
  1168.           GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
  1169.           X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
  1170.           Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
  1171.           BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
  1172.           SelectObject(MemDC,OldBitmap);
  1173.           DeleteDC(MemDc);
  1174.           end;
  1175.         SetBkMode(Msg.WParam, transparent);
  1176.         Msg.Result := GetStockObject(Null_Brush);
  1177.       end;
  1178.     ctlcolor_Dlg:
  1179.       begin
  1180.         SetBkMode(Msg.WParam, Transparent);
  1181.         Msg.Result := GetStockObject(ltGray_Brush);
  1182.       end;
  1183.   else
  1184.     DefWndProc(Msg);
  1185.   end;
  1186. end;
  1187. {************************  TPrgItem    *****************************}
  1188. constructor TPgmItem.Init(NewPgmName,NewPgmFile,NewDir,NewParams:PChar;
  1189.         NewCmdShow,NewAStart:Pchar);
  1190. begin
  1191.     PgmName := StrNew(NewPgmName);
  1192.   PgmFile := StrNew(NewPgmFile);
  1193.   Dir := StrNew(NewDir);
  1194.   Params := StrNew(NewParams);
  1195.   CmdShow := StrNew(NewCmdShow);
  1196.   AStart := StrNew(NewAStart);
  1197. end;
  1198.  
  1199. destructor TPgmItem.Done;
  1200. begin
  1201.     StrDispose(PgmName);
  1202.   StrDispose(PgmFile);
  1203.   StrDispose(Dir);
  1204.   StrDispose(Params);
  1205.   StrDispose(CmdShow);
  1206.   StrDispose(AStart);
  1207. end;
  1208. {************************  TCOCol    *****************************}
  1209. constructor TCOCol.Init(ALimit,ADelta:Integer;NewIniFile:Pchar);
  1210. begin
  1211.     TheItems := New(PCollection,Init(ALimit,ADelta));
  1212.   StrCopy(IniFile,NewIniFile);
  1213. end;
  1214.  
  1215. destructor TCOCol.Done;
  1216. begin
  1217.     Dispose(TheItems,Done);
  1218. end;
  1219.  
  1220. function TCOCol.At(Indx:Integer):PPgmItem;
  1221. begin
  1222.     At := TheItems^.At(Indx);
  1223. end;
  1224.  
  1225. procedure TCOCol.ReadItems(Start,Finish:Integer);
  1226. var
  1227.     Buf1:Array[0..30] of Char;
  1228.   Indx:Integer;
  1229.   IndxStr:Array[0..5] of Char;
  1230.   Found:Boolean;
  1231.   Key:Array[0..20] of Char;
  1232.   PgmName,PgmFile,Dir,Params:Array[0..50] of Char;
  1233.   CmdShow,AStart:Array[0..5] of Char;
  1234. begin
  1235.   for Indx := Start to Finish do
  1236.       begin
  1237.     StrCopy(PgmFile,'');Strcopy(Dir,'');StrCopy(Params,'');StrCopy(CmdShow,'');StrCopy(AStart,'');
  1238.     wvsprintf(IndxStr,'%02i',Indx);
  1239.     Str(Indx,IndxStr); 
  1240.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1241.         GetPrivateProfileString(INISECT,Key,'',PgmName,SizeOf(PgmName),IniFile);
  1242.     if PgmName[0] <> #0 then
  1243.         begin
  1244.         StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1245.             GetPrivateProfileString(INISECT,Key,'',PgmFile,SizeOf(PgmFile),IniFile);
  1246.         StrCat(StrCopy(Key,'Dir'),IndxStr);
  1247.             GetPrivateProfileString(INISECT,Key,'',Dir,SizeOf(dir),IniFile);
  1248.         StrCat(StrCopy(Key,'Params'),IndxStr);
  1249.             GetPrivateProfileString(INISECT,Key,'',Params,SizeOf(Params),IniFile);
  1250.         StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1251.             GetPrivateProfileString(INISECT,Key,'N',Cmdshow,SizeOf(CmdShow),IniFile);
  1252.         StrCat(StrCopy(Key,'AStart'),IndxStr);
  1253.             GetPrivateProfileString(INISECT,Key,'N',AStart,SizeOf(AStart),IniFile);
  1254.         end;
  1255.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmName,PgmFile,Dir,Params,Cmdshow,AStart)));
  1256.     end;
  1257. end;
  1258.  
  1259. procedure TCOCol.ItemGet(var PgmItem:ItemRec);
  1260. var
  1261.   Indx:Integer;
  1262.   IndxStr:Array[0..5] of Char;
  1263.   ErrCode:Integer;
  1264.   TheItem:PPgmItem;
  1265. begin
  1266.     Val(PgmItem.ItemNum,Indx,ErrCode);
  1267.   if (ErrCode <> 0) or (NOT(IsValidIndx(Indx))) then
  1268.       Exit;
  1269.   begin
  1270.   TheItem := TheItems^.At(Indx);
  1271.   If TheItem^.PgmName <> nil then
  1272.       StrCopy(PgmItem.PgmName,TheItem^.PgmName);
  1273.   If TheItem^.PgmFile <> nil then
  1274.       StrCopy(PgmItem.PgmFile,TheItem^.PgmFile);
  1275.   If TheItem^.Dir <> nil then
  1276.       StrCopy(PgmItem.Dir,TheItem^.Dir);
  1277.   If TheItem^.Params <> nil then
  1278.       StrCopy(PgmItem.Params,TheItem^.Params);
  1279.   If TheItem^.Cmdshow <> nil then
  1280.       StrCopy(PgmItem.CmdShow,TheItem^.Cmdshow);
  1281.   If TheItem^.AStart <> nil then
  1282.       StrCopy(PgmItem.AStart,TheItem^.AStart);
  1283.     end;
  1284. end;
  1285.  
  1286. procedure TCOCol.ItemSet(PgmItem:ItemRec);
  1287. var
  1288.     Buf1:Array[0..30] of Char;
  1289.   Indx:Integer;
  1290.   IndxStr:Array[0..5] of Char;
  1291.   Found:Boolean;
  1292.   Key:Array[0..20] of Char;
  1293.   Errval:Integer;
  1294. begin
  1295.     Val(PgmItem.ItemNum,Indx,Errval);
  1296.   If IsValidIndx(Indx) then
  1297.       begin
  1298.        StrCopy(IndxStr,PgmItem.ItemNum) ;
  1299.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1300.         WritePrivateProfileString(INISECT,Key,PgmItem.PgmName,IniFile);
  1301.     StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1302.         WritePrivateProfileString(INISECT,Key,PgmItem.PgmFile,IniFile);
  1303.     StrCat(StrCopy(Key,'Dir'),IndxStr);
  1304.         WritePrivateProfileString(INISECT,Key,PgmItem.Dir,IniFile);
  1305.     StrCat(StrCopy(Key,'Params'),IndxStr);
  1306.         WritePrivateProfileString(INISECT,Key,PgmItem.Params,IniFile);
  1307.     StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1308.         WritePrivateProfileString(INISECT,Key,ANSIUpper(PgmItem.CmdShow),IniFile);
  1309.     StrCat(StrCopy(Key,'AStart'),IndxStr);
  1310.         WritePrivateProfileString(INISECT,Key,AnsiUpper(PgmItem.AStart),IniFile);
  1311.     TheItems^.AtFree(Indx);
  1312.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmItem.PgmName,PgmItem.PgmFile,
  1313.         PgmItem.Dir,PgmItem.Params,PgmItem.Cmdshow,PgmItem.AStart)));
  1314.     end;
  1315. end;
  1316.  
  1317. function TCOCol.GetCount:Integer;
  1318. begin
  1319.     GetCount := TheItems^.Count;
  1320. end;
  1321.  
  1322. function TCOCol.IsValidIndx(Indx:Integer):Boolean;
  1323. begin
  1324.     IsValidIndx :=((Indx >= 0) and (Indx < TheItems^.Count));
  1325. end;
  1326. {************************  TCORButton    *****************************}
  1327. procedure TCORButton.WMRButtonDown(var Msg:TMessage);
  1328. begin
  1329.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1330. end;
  1331. {*************************  TCOGroupBox     **************************}
  1332. procedure TCOGroupBox.SetupWindow;
  1333. begin
  1334.     TGroupBox.SetupWindow;
  1335.   DragAcceptFiles(HWindow,TRUE);
  1336. end;
  1337.  
  1338. function TCOGroupBox.CanClose:Boolean;
  1339. begin
  1340.     DragAcceptFiles(HWindow,FALSE);
  1341.     CanClose := TGroupBox.CanClose;
  1342. end;
  1343.  
  1344. procedure TCOGroupBox.WMDropFiles(var Msg:TMessage);
  1345. var
  1346.     DropItem:hDrop;
  1347.   FileNameBuf:Array[0..fsPathName] of Char;
  1348.   GFileName:PChar;
  1349.   CtrlID:Integer;
  1350.   Loc,SLoc:TPoint;
  1351.   ChildWin:HWnd;
  1352. begin
  1353.     DropItem := Msg.wParam;
  1354.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  1355.   GFileName :=StrNew(FileNameBuf);
  1356.   DragQueryPoint(DropItem,Loc);
  1357.   DragFinish(DropItem);
  1358.   SLoc := Loc;
  1359.   ClienttoScreen(HWindow,SLoc);
  1360.   ChildWin := WindowFromPoint(SLoc);
  1361.   CtrlID := GetDlgCtrlID(ChildWin);
  1362.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  1363.   StrDispose(GFileName);
  1364. end;
  1365. {************************  TCOStatic    *****************************}
  1366. procedure TCOStatic.WMRButtonDown(var Msg:TMessage);
  1367. begin
  1368.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1369. end;
  1370. {***********************  MainLine  ********************************}
  1371. var
  1372.     COApp : TCOApplication;
  1373. begin
  1374.     COApp.Init(INISECT);
  1375.   COApp.Redraw;
  1376.     COApp.Run;
  1377.     COApp.Done;
  1378. end.
  1379.